COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE MEM
C00003 00003	NSUBR MORCOR		Get more core			*
C00005 00004	SUBRS MKNODE,KLNODE	Make and Kill nodes		*
C00007 00005	NSUBR COMPACT
C00012 00006	NSUBR RELOCATE,OFFSET
C00016 ENDMK
C⊗;
TITLE MEM

INTERN OLD44,UNIVER,BLKCNT,AVAIL,INVALID
EXTERN REL
	OLD44:	0	;ORIGINAL JOBREL 44 CONTENTS.
	UNIVER:	0	;POINTER TO UNIVERSE NODE.
	BLKCNT: 0	;NUMBER OF NON EMPTY NODES.
	AVAIL:	0	;POINTER TO FIRST EMPTY NODE.
	REMAINDER:0	;NUMBER OF UNUSED WORDS BETWEEN 
			; THE TOP OF NODE SPACE AND THE TOP OF CORE.
	INVALID:0	;SET DURING SHRINK
	NODSIZ←←=12	;NUMBER OF WORDS PER NODE.
	MINLINK←←-3	;LOWEST NUMBERED LINK
	TYPMASK←←17	;MASK TO EXTRACT TYPE INFORMATION
NSUBR MORCOR		;Get more core			*

;INITIALIZE THE UNIVERSE NODE WHEN NECESSARY.
	SKIPE OLD44↔GO L1		;SKIP ON FIRST TIME ONLY.
	LAC 1,44↔DAC 1,OLD44		;SAVE JOBREL.
	ADDI 1,1↔			;SETUP UNIVERSE NODE.
	ADDI 1,1↔DAC 1,AVAIL
	ADDI 1,1↔DAC 1,BLKCNT
	ADDI 1,1↔DAC 1,UNIVERSE
	SETZM REMAINDER

;FOUR MORE K.
L1:	LAC 1,44↔LAC 0,1↔ADDI 0,10000
	CALLI 11↔FATAL<NO MORE CORE.>
	AOS 1↔SUB 1,REMAINDER↔DAC 2,AC2#↔LAC 2,44
	SETZM(1)↔LIPI(1)↔LAPI(1)1↔BLT(2)
	LACI 2↔DAP @UNIVERSE

;MAKE AVAIL LIST.
	DIP 1,1↔ADD 1,[XWD NODSIZ,0]
	SKIPN@BLKCNT↔GO[
		ADD 1,[XWD NODSIZ,NODSIZ]
		AOS@BLKCNT↔GO .+1]
	DAPZ 1,@AVAIL
L2:	HLRZM 1,(1)↔AOS 3(1)	;EMPTY LINK & EMPTY TYPE-1.
	ADD 1,[XWD NODSIZ,NODSIZ]
	CAILE 2,NODSIZ+NODSIZ-1(1)
	GO L2↔AOS 3(1)

	SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER
	LACI 10000↔LAC 1,UNIVER↔ADDM -3(1)	;CORE SIZE.
	LAC 1,@AVAIL
	LAC 2,AC2↔POP0J
SUBREND MORCOR;4-DEC-72(BGB)
;SUBRS MKNODE,KLNODE	;Make and Kill nodes		*
;____________________________________________________________________

NSUBR MKNODE,NODTYP	;ALLOCATE A BLOCK OF NODSIZ WORDS. *
	SKIPN 1,@AVAIL↔CALL MORCOR	;GET AN EMPTY NODE.
	CDR(1)↔DAP @AVAIL
	SETZM(1)↔AOS @BLKCNT↔ADDI 1,3
	POP P,RETADR#			;SAVE RETURN ADDRESS.
	POP P,(1)			;PLACE NODE TYPE INTO NODE.
	GO @RETADR			;RETURN.
SUBREND MKNODE;4-DEC-72(BGB)
;____________________________________________________________________

NSUBR KLNODE,NODE	;RELEASE  BLOCK OF NODSIZ WORDS.
	LAC 1,NODE↔LAC (1)
	CAIN 0,1↔GO [ FATAL(KILLING EMPTY NODE.)]
	SOS @BLKCNT
	LIPI -3(1)↔LAPI -2(1)		;CLEAR NODE.
	SETZM -3(1)↔BLT 8(1)
	AOS(1)				;MARK NODE TYPE EMPTY-1.
	SUBI 1,3↔LAC@AVAIL		;CONS NODE TO AVAIL LIST.
	DAPZ(1)↔DAPZ 1,@AVAIL
	POP1J
SUBREND KLNODE;4-DEC-72(BGB)
NSUBR COMPACT
;Note: to change to handle non-contiguous blocks of node space,
;rewrite the following macro to know about block boundaries.
	DEFINE NXTNOD(AC,LIMIT)
<	ADDI AC,NODSIZ
	CAML AC,LIMIT
>
	ACCUMULATORS{P1,NODE,HOLE,ONE}
;Pass 1: Locate free nodes below BREAK and move nodes in use above
;break into free nodes, leaving pointer in its place to new node
;location.
	MOVE NODE,@BLKCNT	;CALCULATE ADDRESS OF BREAK
	IMULI NODE,NODSIZ
	ADD NODE,UNIVERSE
	MOVEM NODE,BREAK
	SUBI NODE,NODSIZ	;INCREMENTED AT HLOOP
	MOVEI ONE,$EMPTY	;FOR A FAST TYPE CHECK
	SKIPA HOLE,UNIVERSE
HLOOP:	NXTNOD HOLE,BREAK	;FIND A HOLE BELOW BREAK
	GO UPDATE		;BREAK FOUND, NOW UP POINTS
	CAME ONE,(HOLE)		;IS IT AN EMPTY NODE?
	GO HLOOP
NLOOP:	NXTNOD NODE,44		;FIND A NODE ABOVE BREAK
	GO [ WARNING<NODE COUNT TOO BIG>	;HIT TOP END!
	     GO UPDATE ]
	CAMN ONE,(NODE)		;IS IT AN EMPTY NODE?
	GO NLOOP		;NO, TRY NEXT
	HRLZI 0,MINLINK(NODE)	;YES, COPY NODE INTO HOLE BELOW
	HRRI 0,MINLINK(HOLE)
	BLT 0,NODSIZ+MINLINK-1(HOLE)
	HRRZM HOLE,(NODE)	;MAKE POINTER FROM OLD TO NEW LOCATION
	SETOM INVALID
	GO HLOOP
;Pass two: Go thru all of node space and check for pointers between
;BREAK and top of node space and change them to point to new
;location below BREAK.
	PTYPE←HOLE
UPDATE:	SKIPN INVALID
	POPJ P,
	MOVE NODE,UNIVERS
ULOOP:	MOVE PTYPE,(NODE)
	TLNE PTYPE,400400		;FRAME CHEAT
	SETZ PTYPE,
	ANDI PTYPE,TYPMASK
	HLLZ 0,REL(PTYPE)
	LSH 0,6
	MOVEI P1,NODSIZ+MINLINK-1(NODE)
LLOOP:	JUMPE 0,DORIGHT
	JUMPL 0,[HLRZ 1,(P1)
		 CAMGE 1,BREAK
		 GO .+1
		 CAMLE 1,44
		 GO [ WARNING<INVALID POINTER FOUND>
		      GO .+1 ]
		 MOVE 1,(1)
		 HRLM 1,(P1)
		 GO .+1]
	LSH 0,1
	SOJA P1,LLOOP
DORIGH:	HRLZ 0,REL(PTYPE)
	LSH 0,6
	MOVEI P1,NODSIZ+MINLINK-1(NODE)
RLOOP:	JUMPE 0,DONEXT
	JUMPL 0,[HRRZ 1,(P1)
		 CAMGE 1,BREAK
		 GO .+1
		 CAMLE 1,44
		 GO [ WARNING<INVALID POINTER FOUND>
		      GO .+1 ]
		 MOVE 1,(1)
		 HRRM 1,(P1)
		 GO .+1]
	LSH 0,1
	SOJA P1,RLOOP
DONEXT:	NXTNOD NODE,BREAK
	GO .+2
	GO ULOOP
;We're done, now shrink core size and make a new AVAIL list.
;(This may need to be rewritten for non-contiguous node space)
DONE:	MOVE HOLE,BREAK
	MOVEI 0,MINLINK(HOLE)
	CORE 0,
	FATAL<Can't shrink core!>
	HRRZI 1,MINLINK+1(HOLE)
	CAMN 1,44			;CHECK THE OBSCURE CASE
	GO [ SETZB 0,2			;YES, RIGHT ON THE CORE BOUNDARY
	     GO NOFREE ]		;MKNODE WILL GET MORE WHEN IT NEEDS IT
	HRLI 1,MINLINK(HOLE)		;ZERO FREE AREA
	SETZM MINLINK(HOLE)
	MOVE 2,44			;LEAVE TOP IN 2 FOR FAST COMPARES
	BLT 1,(2)
	SETZ 0,
;	SUBI HOLE,NODSIZ
MKLOOP:	CAIGE 2,NODSIZ+MINLINK-1(HOLE)	;IS IT IN CORE?
	GO AVLFIN
	MOVEM ONE,(HOLE)		;SET TYPE BITS
	HRRZM 0,MINLINK(HOLE)		;LINK TO PREVIOUS FREE NODE
	MOVEI 0,MINLINK(HOLE)		;THIS FREE NODE
	ADDI HOLE,NODSIZ
	GO MKLOOP
AVLFIN:	SUBI 2,MINLINK(HOLE)			;AMOUNT OF SPACE LEFT
NOFREE:	MOVEM 2,REMAINDER
	MOVEM 0,@AVAIL
	SETZM INVALID
	MOVE 1,BREAK
	SUB 1,UNIVERSE
	POPJ P,

DECLARE{BREAK}
SUBREND COMPACT;2-MAY-73(TVR)
NSUBR RELOCATE,OFFSET
	DEFINE NXTNOD(AC,LIMIT)
<	ADDI AC,NODSIZ
	CAML AC,LIMIT
>
	ACCUMULATORS{P1,NODE,HOLE,LOWER,UPPER,DELTA}
	PTYPE←←HOLE
	MOVE UPPER,@BLKCNT	;CALCULATE ADDRESS OF BREAK
	IMULI UPPER,NODSIZ
	MOVE NODE,UNIVERS
	MOVEI LOWER,MINLINK(NODE)
	MOVE DELTA,OFFSET
	SUB LOWER,DELTA
	MOVE UPPER,44
	SUB UPPER,DELTA
ULOOP:	MOVE PTYPE,(NODE)
	TLNE PTYPE,400400		;FRAME CHEAT
	SETZ PTYPE,
	ANDI PTYPE,TYPMASK
	HLLZ 0,REL(PTYPE)
	LSH 0,6
	MOVEI P1,NODSIZ+MINLINK-1(NODE)
LLOOP:	JUMPE 0,DORIGHT
	JUMPL 0,[HLRZ 1,(P1)
		 CAML 1,LOWER
		 CAML 1,UPPER
		 GO .+1
		 ADD 1,DELTA
		 HRLM 1,(P1)
		 GO .+1]
	LSH 0,1
	SOJA P1,LLOOP
DORIGH:	HRLZ 0,REL(PTYPE)
	LSH 0,6
	MOVEI P1,NODSIZ+MINLINK-1(NODE)
RLOOP:	JUMPE 0,DONEXT
	JUMPL 0,[HRRZ 1,(P1)
		 CAML 1,LOWER
		 CAML 1,UPPER
		 GO .+1
		 ADD 1,DELTA
		 HRRM 1,(P1)
		 GO .+1]
	LSH 0,1
	SOJA P1,RLOOP
DONEXT:	NXTNOD NODE,44
	GO [ SETZM INVALID↔POP1J ]
	GO ULOOP
SUBREND RELOCATE;2-MAY-73(TVR)